home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / cmds / gdb-4.5 / dist / gdb / m2-exp.y < prev    next >
Encoding:
Text File  |  1992-04-02  |  29.4 KB  |  1,268 lines
  1. /* YACC grammar for Modula-2 expressions, for GDB.
  2.    Copyright (C) 1986, 1989, 1990, 1991 Free Software Foundation, Inc.
  3.    Generated from expread.y (now c-exp.y) and contributed by the Department
  4.    of Computer Science at the State University of New York at Buffalo, 1991.
  5.  
  6. This file is part of GDB.
  7.  
  8. This program is free software; you can redistribute it and/or modify
  9. it under the terms of the GNU General Public License as published by
  10. the Free Software Foundation; either version 2 of the License, or
  11. (at your option) any later version.
  12.  
  13. This program is distributed in the hope that it will be useful,
  14. but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. GNU General Public License for more details.
  17.  
  18. You should have received a copy of the GNU General Public License
  19. along with this program; if not, write to the Free Software
  20. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
  21.  
  22. /* Parse a Modula-2 expression from text in a string,
  23.    and return the result as a  struct expression  pointer.
  24.    That structure contains arithmetic operations in reverse polish,
  25.    with constants represented by operations that are followed by special data.
  26.    See expression.h for the details of the format.
  27.    What is important here is that it can be built up sequentially
  28.    during the process of parsing; the lower levels of the tree always
  29.    come first in the result.  */
  30.    
  31. %{
  32. #include <stdio.h>
  33. #include <string.h>
  34. #include "defs.h"
  35. #include "symtab.h"
  36. #include "gdbtypes.h"
  37. #include "frame.h"
  38. #include "expression.h"
  39. #include "language.h"
  40. #include "value.h"
  41. #include "parser-defs.h"
  42. #include "bfd.h"
  43. #include "symfile.h"
  44. #include "objfiles.h"
  45.  
  46. /* Ensure that if the generated parser contains any calls to malloc/realloc,
  47.    that they get mapped to xmalloc/xrealloc. */
  48.  
  49. #define malloc    xmalloc
  50. #define realloc    xrealloc
  51.  
  52. /* These MUST be included in any grammar file!!!!
  53.    Please choose unique names! */
  54. #define    yymaxdepth m2_maxdepth
  55. #define    yyparse    m2_parse
  56. #define    yylex    m2_lex
  57. #define    yyerror    m2_error
  58. #define    yylval    m2_lval
  59. #define    yychar    m2_char
  60. #define    yydebug    m2_debug
  61. #define    yypact    m2_pact
  62. #define    yyr1    m2_r1
  63. #define    yyr2    m2_r2
  64. #define    yydef    m2_def
  65. #define    yychk    m2_chk
  66. #define    yypgo    m2_pgo
  67. #define    yyact    m2_act
  68. #define    yyexca    m2_exca
  69. #define yyerrflag m2_errflag
  70. #define yynerrs    m2_nerrs
  71. #define    yyps    m2_ps
  72. #define    yypv    m2_pv
  73. #define    yys    m2_s
  74. #define    yy_yys    m2_yys
  75. #define    yystate    m2_state
  76. #define    yytmp    m2_tmp
  77. #define    yyv    m2_v
  78. #define    yy_yyv    m2_yyv
  79. #define    yyval    m2_val
  80. #define    yylloc    m2_lloc
  81.  
  82. #if 0
  83. static char *
  84. make_qualname PARAMS ((char *, char *));
  85. #endif
  86.  
  87. static int
  88. parse_number PARAMS ((int));
  89.  
  90. static int
  91. yylex PARAMS ((void));
  92.  
  93. static void
  94. yyerror PARAMS ((char *));
  95.  
  96. int
  97. yyparse PARAMS ((void));
  98.  
  99. /* The sign of the number being parsed. */
  100. int number_sign = 1;
  101.  
  102. /* The block that the module specified by the qualifer on an identifer is
  103.    contained in, */
  104. struct block *modblock=0;
  105.  
  106. /* #define    YYDEBUG    1 */
  107.  
  108. %}
  109.  
  110. /* Although the yacc "value" of an expression is not used,
  111.    since the result is stored in the structure being created,
  112.    other node types do have values.  */
  113.  
  114. %union
  115.   {
  116.     LONGEST lval;
  117.     unsigned LONGEST ulval;
  118.     double dval;
  119.     struct symbol *sym;
  120.     struct type *tval;
  121.     struct stoken sval;
  122.     int voidval;
  123.     struct block *bval;
  124.     enum exp_opcode opcode;
  125.     struct internalvar *ivar;
  126.  
  127.     struct type **tvec;
  128.     int *ivec;
  129.   }
  130.  
  131. %type <voidval> exp type_exp start set
  132. %type <voidval> variable
  133. %type <tval> type
  134. %type <bval> block 
  135. %type <sym> fblock 
  136.  
  137. %token <lval> INT HEX ERROR
  138. %token <ulval> UINT TRUE FALSE CHAR
  139. %token <dval> FLOAT
  140.  
  141. /* Both NAME and TYPENAME tokens represent symbols in the input,
  142.    and both convey their data as strings.
  143.    But a TYPENAME is a string that happens to be defined as a typedef
  144.    or builtin type name (such as int or char)
  145.    and a NAME is any other symbol.
  146.  
  147.    Contexts where this distinction is not important can use the
  148.    nonterminal "name", which matches either NAME or TYPENAME.  */
  149.  
  150. %token <sval> STRING
  151. %token <sval> NAME BLOCKNAME IDENT VARNAME
  152. %token <sval> TYPENAME
  153.  
  154. %token SIZE CAP ORD HIGH ABS MIN_FUNC MAX_FUNC FLOAT_FUNC VAL CHR ODD TRUNC
  155. %token INC DEC INCL EXCL
  156.  
  157. /* The GDB scope operator */
  158. %token COLONCOLON
  159.  
  160. %token <lval> LAST REGNAME
  161.  
  162. %token <ivar> INTERNAL_VAR
  163.  
  164. /* M2 tokens */
  165. %left ','
  166. %left ABOVE_COMMA
  167. %nonassoc ASSIGN
  168. %left '<' '>' LEQ GEQ '=' NOTEQUAL '#' IN
  169. %left OROR
  170. %left ANDAND '&'
  171. %left '@'
  172. %left '+' '-'
  173. %left '*' '/' DIV MOD
  174. %right UNARY
  175. %right '^' DOT '[' '('
  176. %right NOT '~'
  177. %left COLONCOLON QID
  178. /* This is not an actual token ; it is used for precedence. 
  179. %right QID
  180. */
  181. %%
  182.  
  183. start   :    exp
  184.     |    type_exp
  185.     ;
  186.  
  187. type_exp:    type
  188.         { write_exp_elt_opcode(OP_TYPE);
  189.           write_exp_elt_type($1);
  190.           write_exp_elt_opcode(OP_TYPE);
  191.         }
  192.     ;
  193.  
  194. /* Expressions */
  195.  
  196. exp     :       exp '^'   %prec UNARY
  197.                         { write_exp_elt_opcode (UNOP_IND); }
  198.  
  199. exp    :    '-'
  200.             { number_sign = -1; }
  201.         exp    %prec UNARY
  202.             { number_sign = 1;
  203.               write_exp_elt_opcode (UNOP_NEG); }
  204.     ;
  205.  
  206. exp    :    '+' exp    %prec UNARY
  207.         { write_exp_elt_opcode(UNOP_PLUS); }
  208.     ;
  209.  
  210. exp    :    not_exp exp %prec UNARY
  211.             { write_exp_elt_opcode (UNOP_ZEROP); }
  212.     ;
  213.  
  214. not_exp    :    NOT
  215.     |    '~'
  216.     ;
  217.  
  218. exp    :    CAP '(' exp ')'
  219.             { write_exp_elt_opcode (UNOP_CAP); }
  220.     ;
  221.  
  222. exp    :    ORD '(' exp ')'
  223.             { write_exp_elt_opcode (UNOP_ORD); }
  224.     ;
  225.  
  226. exp    :    ABS '(' exp ')'
  227.             { write_exp_elt_opcode (UNOP_ABS); }
  228.     ;
  229.  
  230. exp    :     HIGH '(' exp ')'
  231.             { write_exp_elt_opcode (UNOP_HIGH); }
  232.     ;
  233.  
  234. exp     :    MIN_FUNC '(' type ')'
  235.             { write_exp_elt_opcode (UNOP_MIN);
  236.               write_exp_elt_type ($3);
  237.               write_exp_elt_opcode (UNOP_MIN); }
  238.     ;
  239.  
  240. exp    :     MAX_FUNC '(' type ')'
  241.             { write_exp_elt_opcode (UNOP_MAX);
  242.               write_exp_elt_type ($3);
  243.               write_exp_elt_opcode (UNOP_MIN); }
  244.     ;
  245.  
  246. exp    :    FLOAT_FUNC '(' exp ')'
  247.             { write_exp_elt_opcode (UNOP_FLOAT); }
  248.     ;
  249.  
  250. exp    :    VAL '(' type ',' exp ')'
  251.             { write_exp_elt_opcode (BINOP_VAL);
  252.               write_exp_elt_type ($3);
  253.               write_exp_elt_opcode (BINOP_VAL); }
  254.     ;
  255.  
  256. exp    :    CHR '(' exp ')'
  257.             { write_exp_elt_opcode (UNOP_CHR); }
  258.     ;
  259.  
  260. exp    :    ODD '(' exp ')'
  261.             { write_exp_elt_opcode (UNOP_ODD); }
  262.     ;
  263.  
  264. exp    :    TRUNC '(' exp ')'
  265.             { write_exp_elt_opcode (UNOP_TRUNC); }
  266.     ;
  267.  
  268. exp    :    SIZE exp       %prec UNARY
  269.             { write_exp_elt_opcode (UNOP_SIZEOF); }
  270.     ;
  271.  
  272.  
  273. exp    :    INC '(' exp ')'
  274.             { write_exp_elt_opcode(UNOP_PREINCREMENT); }
  275.     ;
  276.  
  277. exp    :    INC '(' exp ',' exp ')'
  278.             { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
  279.               write_exp_elt_opcode(BINOP_ADD);
  280.               write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
  281.     ;
  282.  
  283. exp    :    DEC '(' exp ')'
  284.             { write_exp_elt_opcode(UNOP_PREDECREMENT);}
  285.     ;
  286.  
  287. exp    :    DEC '(' exp ',' exp ')'
  288.             { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
  289.               write_exp_elt_opcode(BINOP_SUB);
  290.               write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
  291.     ;
  292.  
  293. exp    :    exp DOT NAME
  294.             { write_exp_elt_opcode (STRUCTOP_STRUCT);
  295.               write_exp_string ($3);
  296.               write_exp_elt_opcode (STRUCTOP_STRUCT); }
  297.     ;
  298.  
  299. exp    :    set
  300.     ;
  301.  
  302. exp    :    exp IN set
  303.             { error("Sets are not implemented.");}
  304.     ;
  305.  
  306. exp    :    INCL '(' exp ',' exp ')'
  307.             { error("Sets are not implemented.");}
  308.     ;
  309.  
  310. exp    :    EXCL '(' exp ',' exp ')'
  311.             { error("Sets are not implemented.");}
  312.  
  313. set    :    '{' arglist '}'
  314.             { error("Sets are not implemented.");}
  315.     |    type '{' arglist '}'
  316.             { error("Sets are not implemented.");}
  317.     ;
  318.  
  319.  
  320. /* Modula-2 array subscript notation [a,b,c...] */
  321. exp     :       exp '['
  322.                         /* This function just saves the number of arguments
  323.                that follow in the list.  It is *not* specific to
  324.                function types */
  325.                         { start_arglist(); }
  326.                 non_empty_arglist ']'  %prec DOT
  327.                         { write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT);
  328.               write_exp_elt_longcst ((LONGEST) end_arglist());
  329.               write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT); }
  330.         ;
  331.  
  332. exp    :    exp '('
  333.             /* This is to save the value of arglist_len
  334.                being accumulated by an outer function call.  */
  335.             { start_arglist (); }
  336.         arglist ')'    %prec DOT
  337.             { write_exp_elt_opcode (OP_FUNCALL);
  338.               write_exp_elt_longcst ((LONGEST) end_arglist ());
  339.               write_exp_elt_opcode (OP_FUNCALL); }
  340.     ;
  341.  
  342. arglist    :
  343.     ;
  344.  
  345. arglist    :    exp
  346.             { arglist_len = 1; }
  347.     ;
  348.  
  349. arglist    :    arglist ',' exp   %prec ABOVE_COMMA
  350.             { arglist_len++; }
  351.     ;
  352.  
  353. non_empty_arglist
  354.         :       exp
  355.                         { arglist_len = 1; }
  356.     ;
  357.  
  358. non_empty_arglist
  359.         :       non_empty_arglist ',' exp %prec ABOVE_COMMA
  360.                             { arglist_len++; }
  361.          ;
  362.  
  363. /* GDB construct */
  364. exp    :    '{' type '}' exp  %prec UNARY
  365.             { write_exp_elt_opcode (UNOP_MEMVAL);
  366.               write_exp_elt_type ($2);
  367.               write_exp_elt_opcode (UNOP_MEMVAL); }
  368.     ;
  369.  
  370. exp     :       type '(' exp ')' %prec UNARY
  371.                         { write_exp_elt_opcode (UNOP_CAST);
  372.               write_exp_elt_type ($1);
  373.               write_exp_elt_opcode (UNOP_CAST); }
  374.     ;
  375.  
  376. exp    :    '(' exp ')'
  377.             { }
  378.     ;
  379.  
  380. /* Binary operators in order of decreasing precedence.  Note that some
  381.    of these operators are overloaded!  (ie. sets) */
  382.  
  383. /* GDB construct */
  384. exp    :    exp '@' exp
  385.             { write_exp_elt_opcode (BINOP_REPEAT); }
  386.     ;
  387.  
  388. exp    :    exp '*' exp
  389.             { write_exp_elt_opcode (BINOP_MUL); }
  390.     ;
  391.  
  392. exp    :    exp '/' exp
  393.             { write_exp_elt_opcode (BINOP_DIV); }
  394.     ;
  395.  
  396. exp     :       exp DIV exp
  397.                         { write_exp_elt_opcode (BINOP_INTDIV); }
  398.         ;
  399.  
  400. exp    :    exp MOD exp
  401.             { write_exp_elt_opcode (BINOP_REM); }
  402.     ;
  403.  
  404. exp    :    exp '+' exp
  405.             { write_exp_elt_opcode (BINOP_ADD); }
  406.     ;
  407.  
  408. exp    :    exp '-' exp
  409.             { write_exp_elt_opcode (BINOP_SUB); }
  410.     ;
  411.  
  412. exp    :    exp '=' exp
  413.             { write_exp_elt_opcode (BINOP_EQUAL); }
  414.     ;
  415.  
  416. exp    :    exp NOTEQUAL exp
  417.             { write_exp_elt_opcode (BINOP_NOTEQUAL); }
  418.         |       exp '#' exp
  419.                         { write_exp_elt_opcode (BINOP_NOTEQUAL); }
  420.     ;
  421.  
  422. exp    :    exp LEQ exp
  423.             { write_exp_elt_opcode (BINOP_LEQ); }
  424.     ;
  425.  
  426. exp    :    exp GEQ exp
  427.             { write_exp_elt_opcode (BINOP_GEQ); }
  428.     ;
  429.  
  430. exp    :    exp '<' exp
  431.             { write_exp_elt_opcode (BINOP_LESS); }
  432.     ;
  433.  
  434. exp    :    exp '>' exp
  435.             { write_exp_elt_opcode (BINOP_GTR); }
  436.     ;
  437.  
  438. exp    :    exp ANDAND exp
  439.             { write_exp_elt_opcode (BINOP_AND); }
  440.     ;
  441.  
  442. exp    :    exp '&'    exp
  443.             { write_exp_elt_opcode (BINOP_AND); }
  444.     ;
  445.  
  446. exp    :    exp OROR exp
  447.             { write_exp_elt_opcode (BINOP_OR); }
  448.     ;
  449.  
  450. exp    :    exp ASSIGN exp
  451.             { write_exp_elt_opcode (BINOP_ASSIGN); }
  452.     ;
  453.  
  454.  
  455. /* Constants */
  456.  
  457. exp    :    TRUE
  458.             { write_exp_elt_opcode (OP_BOOL);
  459.               write_exp_elt_longcst ((LONGEST) $1);
  460.               write_exp_elt_opcode (OP_BOOL); }
  461.     ;
  462.  
  463. exp    :    FALSE
  464.             { write_exp_elt_opcode (OP_BOOL);
  465.               write_exp_elt_longcst ((LONGEST) $1);
  466.               write_exp_elt_opcode (OP_BOOL); }
  467.     ;
  468.  
  469. exp    :    INT
  470.             { write_exp_elt_opcode (OP_LONG);
  471.               write_exp_elt_type (builtin_type_m2_int);
  472.               write_exp_elt_longcst ((LONGEST) $1);
  473.               write_exp_elt_opcode (OP_LONG); }
  474.     ;
  475.  
  476. exp    :    UINT
  477.             {
  478.               write_exp_elt_opcode (OP_LONG);
  479.               write_exp_elt_type (builtin_type_m2_card);
  480.               write_exp_elt_longcst ((LONGEST) $1);
  481.               write_exp_elt_opcode (OP_LONG);
  482.             }
  483.     ;
  484.  
  485. exp    :    CHAR
  486.             { write_exp_elt_opcode (OP_LONG);
  487.               write_exp_elt_type (builtin_type_m2_char);
  488.               write_exp_elt_longcst ((LONGEST) $1);
  489.               write_exp_elt_opcode (OP_LONG); }
  490.     ;
  491.  
  492.  
  493. exp    :    FLOAT
  494.             { write_exp_elt_opcode (OP_DOUBLE);
  495.               write_exp_elt_type (builtin_type_m2_real);
  496.               write_exp_elt_dblcst ($1);
  497.               write_exp_elt_opcode (OP_DOUBLE); }
  498.     ;
  499.  
  500. exp    :    variable
  501.     ;
  502.  
  503. /* The GDB internal variable $$, et al. */
  504. exp    :    LAST
  505.             { write_exp_elt_opcode (OP_LAST);
  506.               write_exp_elt_longcst ((LONGEST) $1);
  507.               write_exp_elt_opcode (OP_LAST); }
  508.     ;
  509.  
  510. exp    :    REGNAME
  511.             { write_exp_elt_opcode (OP_REGISTER);
  512.               write_exp_elt_longcst ((LONGEST) $1);
  513.               write_exp_elt_opcode (OP_REGISTER); }
  514.     ;
  515.  
  516. exp    :    SIZE '(' type ')'    %prec UNARY
  517.             { write_exp_elt_opcode (OP_LONG);
  518.               write_exp_elt_type (builtin_type_int);
  519.               write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
  520.               write_exp_elt_opcode (OP_LONG); }
  521.     ;
  522.  
  523. exp    :    STRING
  524.             { write_exp_elt_opcode (OP_M2_STRING);
  525.               write_exp_string ($1);
  526.               write_exp_elt_opcode (OP_M2_STRING); }
  527.     ;
  528.  
  529. /* This will be used for extensions later.  Like adding modules. */
  530. block    :    fblock    
  531.             { $$ = SYMBOL_BLOCK_VALUE($1); }
  532.     ;
  533.  
  534. fblock    :    BLOCKNAME
  535.             { struct symbol *sym
  536.                 = lookup_symbol (copy_name ($1), expression_context_block,
  537.                          VAR_NAMESPACE, 0, NULL);
  538.               $$ = sym;}
  539.     ;
  540.                  
  541.  
  542. /* GDB scope operator */
  543. fblock    :    block COLONCOLON BLOCKNAME
  544.             { struct symbol *tem
  545.                 = lookup_symbol (copy_name ($3), $1,
  546.                          VAR_NAMESPACE, 0, NULL);
  547.               if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
  548.                 error ("No function \"%s\" in specified context.",
  549.                    copy_name ($3));
  550.               $$ = tem;
  551.             }
  552.     ;
  553.  
  554. /* Useful for assigning to PROCEDURE variables */
  555. variable:    fblock
  556.             { write_exp_elt_opcode(OP_VAR_VALUE);
  557.               write_exp_elt_sym ($1);
  558.               write_exp_elt_opcode (OP_VAR_VALUE); }
  559.     ;
  560.  
  561. /* GDB internal ($foo) variable */
  562. variable:    INTERNAL_VAR
  563.             { write_exp_elt_opcode (OP_INTERNALVAR);
  564.               write_exp_elt_intern ($1);
  565.               write_exp_elt_opcode (OP_INTERNALVAR); }
  566.     ;
  567.  
  568. /* GDB scope operator */
  569. variable:    block COLONCOLON NAME
  570.             { struct symbol *sym;
  571.               sym = lookup_symbol (copy_name ($3), $1,
  572.                            VAR_NAMESPACE, 0, NULL);
  573.               if (sym == 0)
  574.                 error ("No symbol \"%s\" in specified context.",
  575.                    copy_name ($3));
  576.  
  577.               write_exp_elt_opcode (OP_VAR_VALUE);
  578.               write_exp_elt_sym (sym);
  579.               write_exp_elt_opcode (OP_VAR_VALUE); }
  580.     ;
  581.  
  582. /* Base case for variables. */
  583. variable:    NAME
  584.             { struct symbol *sym;
  585.               int is_a_field_of_this;
  586.  
  587.                sym = lookup_symbol (copy_name ($1),
  588.                            expression_context_block,
  589.                            VAR_NAMESPACE,
  590.                            &is_a_field_of_this,
  591.                            NULL);
  592.               if (sym)
  593.                 {
  594.                   switch (sym->class)
  595.                 {
  596.                 case LOC_REGISTER:
  597.                 case LOC_ARG:
  598.                 case LOC_LOCAL:
  599.                 case LOC_REF_ARG:
  600.                 case LOC_REGPARM:
  601.                 case LOC_LOCAL_ARG:
  602.                   if (innermost_block == 0 ||
  603.                       contained_in (block_found,
  604.                             innermost_block))
  605.                     innermost_block = block_found;
  606.                   break;
  607.  
  608.                 case LOC_UNDEF:
  609.                 case LOC_CONST:
  610.                 case LOC_STATIC:
  611.                 case LOC_TYPEDEF:
  612.                 case LOC_LABEL:    /* maybe should go above? */
  613.                 case LOC_BLOCK:
  614.                 case LOC_CONST_BYTES:
  615.                   /* These are listed so gcc -Wall will reveal
  616.                      un-handled cases.  */
  617.                   break;
  618.                 }
  619.                   write_exp_elt_opcode (OP_VAR_VALUE);
  620.                   write_exp_elt_sym (sym);
  621.                   write_exp_elt_opcode (OP_VAR_VALUE);
  622.                 }
  623.               else
  624.                 {
  625.                   struct minimal_symbol *msymbol;
  626.                   register char *arg = copy_name ($1);
  627.  
  628.                   msymbol = lookup_minimal_symbol (arg,
  629.                       (struct objfile *) NULL);
  630.                   if (msymbol != NULL)
  631.                 {
  632.                   write_exp_elt_opcode (OP_LONG);
  633.                   write_exp_elt_type (builtin_type_int);
  634.                   write_exp_elt_longcst ((LONGEST) msymbol -> address);
  635.                   write_exp_elt_opcode (OP_LONG);
  636.                   write_exp_elt_opcode (UNOP_MEMVAL);
  637.                   if (msymbol -> type == mst_data ||
  638.                       msymbol -> type == mst_bss)
  639.                     write_exp_elt_type (builtin_type_int);
  640.                   else if (msymbol -> type == mst_text)
  641.                     write_exp_elt_type (lookup_function_type (builtin_type_int));
  642.                   else
  643.                     write_exp_elt_type (builtin_type_char);
  644.                   write_exp_elt_opcode (UNOP_MEMVAL);
  645.                 }
  646.                   else if (!have_full_symbols () && !have_partial_symbols ())
  647.                 error ("No symbol table is loaded.  Use the \"symbol-file\" command.");
  648.                   else
  649.                 error ("No symbol \"%s\" in current context.",
  650.                        copy_name ($1));
  651.                 }
  652.             }
  653.     ;
  654.  
  655. type
  656.     :    TYPENAME
  657.             { $$ = lookup_typename (copy_name ($1),
  658.                         expression_context_block, 0); }
  659.  
  660.     ;
  661.  
  662. %%
  663.  
  664. #if 0  /* FIXME! */
  665. int
  666. overflow(a,b)
  667.    long a,b;
  668. {
  669.    return (MAX_OF_TYPE(builtin_type_m2_int) - b) < a;
  670. }
  671.  
  672. int
  673. uoverflow(a,b)
  674.    unsigned long a,b;
  675. {
  676.    return (MAX_OF_TYPE(builtin_type_m2_card) - b) < a;
  677. }
  678. #endif /* FIXME */
  679.  
  680. /* Take care of parsing a number (anything that starts with a digit).
  681.    Set yylval and return the token type; update lexptr.
  682.    LEN is the number of characters in it.  */
  683.  
  684. /*** Needs some error checking for the float case ***/
  685.  
  686. static int
  687. parse_number (olen)
  688.      int olen;
  689. {
  690.   register char *p = lexptr;
  691.   register LONGEST n = 0;
  692.   register LONGEST prevn = 0;
  693.   register int c,i,ischar=0;
  694.   register int base = input_radix;
  695.   register int len = olen;
  696.   int unsigned_p = number_sign == 1 ? 1 : 0;
  697.  
  698.   if(p[len-1] == 'H')
  699.   {
  700.      base = 16;
  701.      len--;
  702.   }
  703.   else if(p[len-1] == 'C' || p[len-1] == 'B')
  704.   {
  705.      base = 8;
  706.      ischar = p[len-1] == 'C';
  707.      len--;
  708.   }
  709.  
  710.   /* Scan the number */
  711.   for (c = 0; c < len; c++)
  712.   {
  713.     if (p[c] == '.' && base == 10)
  714.       {
  715.     /* It's a float since it contains a point.  */
  716.     yylval.dval = atof (p);
  717.     lexptr += len;
  718.     return FLOAT;
  719.       }
  720.     if (p[c] == '.' && base != 10)
  721.        error("Floating point numbers must be base 10.");
  722.     if (base == 10 && (p[c] < '0' || p[c] > '9'))
  723.        error("Invalid digit \'%c\' in number.",p[c]);
  724.  }
  725.  
  726.   while (len-- > 0)
  727.     {
  728.       c = *p++;
  729.       n *= base;
  730.       if( base == 8 && (c == '8' || c == '9'))
  731.      error("Invalid digit \'%c\' in octal number.",c);
  732.       if (c >= '0' && c <= '9')
  733.     i = c - '0';
  734.       else
  735.     {
  736.       if (base == 16 && c >= 'A' && c <= 'F')
  737.         i = c - 'A' + 10;
  738.       else
  739.          return ERROR;
  740.     }
  741.       n+=i;
  742.       if(i >= base)
  743.      return ERROR;
  744.       if(!unsigned_p && number_sign == 1 && (prevn >= n))
  745.      unsigned_p=1;        /* Try something unsigned */
  746.       /* Don't do the range check if n==i and i==0, since that special
  747.      case will give an overflow error. */
  748.       if(RANGE_CHECK && n!=i && i)
  749.       {
  750.      if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
  751.         ((!unsigned_p && number_sign==-1) && -prevn <= -n))
  752.         range_error("Overflow on numeric constant.");
  753.       }
  754.      prevn=n;
  755.     }
  756.  
  757.   lexptr = p;
  758.   if(*p == 'B' || *p == 'C' || *p == 'H')
  759.      lexptr++;            /* Advance past B,C or H */
  760.  
  761.   if (ischar)
  762.   {
  763.      yylval.ulval = n;
  764.      return CHAR;
  765.   }
  766.   else if ( unsigned_p && number_sign == 1)
  767.   {
  768.      yylval.ulval = n;
  769.      return UINT;
  770.   }
  771.   else if((unsigned_p && (n<0))) {
  772.      range_error("Overflow on numeric constant -- number too large.");
  773.      /* But, this can return if range_check == range_warn.  */
  774.   }
  775.   yylval.lval = n;
  776.   return INT;
  777. }
  778.  
  779.  
  780. /* Some tokens */
  781.  
  782. static struct
  783. {
  784.    char name[2];
  785.    int token;
  786. } tokentab2[] =
  787. {
  788.     {"<>",    NOTEQUAL      },
  789.     {":=",    ASSIGN     },
  790.     {"<=",    LEQ     },
  791.     {">=",    GEQ     },
  792.     {"::",    COLONCOLON },
  793.  
  794. };
  795.  
  796. /* Some specific keywords */
  797.  
  798. struct keyword {
  799.    char keyw[10];
  800.    int token;
  801. };
  802.  
  803. static struct keyword keytab[] =
  804. {
  805.     {"OR" ,   OROR     },
  806.     {"IN",    IN         },/* Note space after IN */
  807.     {"AND",   ANDAND     },
  808.     {"ABS",   ABS     },
  809.     {"CHR",   CHR     },
  810.     {"DEC",   DEC     },
  811.     {"NOT",   NOT     },
  812.     {"DIV",   DIV         },
  813.     {"INC",   INC     },
  814.     {"MAX",   MAX_FUNC     },
  815.     {"MIN",   MIN_FUNC     },
  816.     {"MOD",   MOD     },
  817.     {"ODD",   ODD     },
  818.     {"CAP",   CAP     },
  819.     {"ORD",   ORD     },
  820.     {"VAL",   VAL     },
  821.     {"EXCL",  EXCL     },
  822.     {"HIGH",  HIGH       },
  823.     {"INCL",  INCL     },
  824.     {"SIZE",  SIZE       },
  825.     {"FLOAT", FLOAT_FUNC },
  826.     {"TRUNC", TRUNC     },
  827. };
  828.  
  829.  
  830. /* Read one token, getting characters through lexptr.  */
  831.  
  832. /* This is where we will check to make sure that the language and the operators used are
  833.    compatible  */
  834.  
  835. static int
  836. yylex ()
  837. {
  838.   register int c;
  839.   register int namelen;
  840.   register int i;
  841.   register char *tokstart;
  842.   register char quote;
  843.  
  844.  retry:
  845.  
  846.   tokstart = lexptr;
  847.  
  848.  
  849.   /* See if it is a special token of length 2 */
  850.   for( i = 0 ; i < sizeof tokentab2 / sizeof tokentab2[0] ; i++)
  851.      if(!strncmp(tokentab2[i].name, tokstart, 2))
  852.      {
  853.     lexptr += 2;
  854.     return tokentab2[i].token;
  855.      }
  856.  
  857.   switch (c = *tokstart)
  858.     {
  859.     case 0:
  860.       return 0;
  861.  
  862.     case ' ':
  863.     case '\t':
  864.     case '\n':
  865.       lexptr++;
  866.       goto retry;
  867.  
  868.     case '(':
  869.       paren_depth++;
  870.       lexptr++;
  871.       return c;
  872.  
  873.     case ')':
  874.       if (paren_depth == 0)
  875.     return 0;
  876.       paren_depth--;
  877.       lexptr++;
  878.       return c;
  879.  
  880.     case ',':
  881.       if (comma_terminates && paren_depth == 0)
  882.     return 0;
  883.       lexptr++;
  884.       return c;
  885.  
  886.     case '.':
  887.       /* Might be a floating point number.  */
  888.       if (lexptr[1] >= '0' && lexptr[1] <= '9')
  889.     break;            /* Falls into number code.  */
  890.       else
  891.       {
  892.      lexptr++;
  893.      return DOT;
  894.       }
  895.  
  896. /* These are character tokens that appear as-is in the YACC grammar */
  897.     case '+':
  898.     case '-':
  899.     case '*':
  900.     case '/':
  901.     case '^':
  902.     case '<':
  903.     case '>':
  904.     case '[':
  905.     case ']':
  906.     case '=':
  907.     case '{':
  908.     case '}':
  909.     case '#':
  910.     case '@':
  911.     case '~':
  912.     case '&':
  913.       lexptr++;
  914.       return c;
  915.  
  916.     case '\'' :
  917.     case '"':
  918.       quote = c;
  919.       for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
  920.     if (c == '\\')
  921.       {
  922.         c = tokstart[++namelen];
  923.         if (c >= '0' && c <= '9')
  924.           {
  925.         c = tokstart[++namelen];
  926.         if (c >= '0' && c <= '9')
  927.           c = tokstart[++namelen];
  928.           }
  929.       }
  930.       if(c != quote)
  931.      error("Unterminated string or character constant.");
  932.       yylval.sval.ptr = tokstart + 1;
  933.       yylval.sval.length = namelen - 1;
  934.       lexptr += namelen + 1;
  935.  
  936.       if(namelen == 2)      /* Single character */
  937.       {
  938.        yylval.ulval = tokstart[1];
  939.        return CHAR;
  940.       }
  941.       else
  942.      return STRING;
  943.     }
  944.  
  945.   /* Is it a number?  */
  946.   /* Note:  We have already dealt with the case of the token '.'.
  947.      See case '.' above.  */
  948.   if ((c >= '0' && c <= '9'))
  949.     {
  950.       /* It's a number.  */
  951.       int got_dot = 0, got_e = 0;
  952.       register char *p = tokstart;
  953.       int toktype;
  954.  
  955.       for (++p ;; ++p)
  956.     {
  957.       if (!got_e && (*p == 'e' || *p == 'E'))
  958.         got_dot = got_e = 1;
  959.       else if (!got_dot && *p == '.')
  960.         got_dot = 1;
  961.       else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
  962.            && (*p == '-' || *p == '+'))
  963.         /* This is the sign of the exponent, not the end of the
  964.            number.  */
  965.         continue;
  966.       else if ((*p < '0' || *p > '9') &&
  967.            (*p < 'A' || *p > 'F') &&
  968.            (*p != 'H'))  /* Modula-2 hexadecimal number */
  969.         break;
  970.     }
  971.     toktype = parse_number (p - tokstart);
  972.         if (toktype == ERROR)
  973.       {
  974.         char *err_copy = (char *) alloca (p - tokstart + 1);
  975.  
  976.         bcopy (tokstart, err_copy, p - tokstart);
  977.         err_copy[p - tokstart] = 0;
  978.         error ("Invalid number \"%s\".", err_copy);
  979.       }
  980.     lexptr = p;
  981.     return toktype;
  982.     }
  983.  
  984.   if (!(c == '_' || c == '$'
  985.     || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
  986.     /* We must have come across a bad character (e.g. ';').  */
  987.     error ("Invalid character '%c' in expression.", c);
  988.  
  989.   /* It's a name.  See how long it is.  */
  990.   namelen = 0;
  991.   for (c = tokstart[namelen];
  992.        (c == '_' || c == '$' || (c >= '0' && c <= '9')
  993.     || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
  994.        c = tokstart[++namelen])
  995.     ;
  996.  
  997.   /* The token "if" terminates the expression and is NOT
  998.      removed from the input stream.  */
  999.   if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
  1000.     {
  1001.       return 0;
  1002.     }
  1003.  
  1004.   lexptr += namelen;
  1005.  
  1006.   /* Handle the tokens $digits; also $ (short for $0) and $$ (short for $$1)
  1007.      and $$digits (equivalent to $<-digits> if you could type that).
  1008.      Make token type LAST, and put the number (the digits) in yylval.  */
  1009.  
  1010.   if (*tokstart == '$')
  1011.     {
  1012.       register int negate = 0;
  1013.       c = 1;
  1014.       /* Double dollar means negate the number and add -1 as well.
  1015.      Thus $$ alone means -1.  */
  1016.       if (namelen >= 2 && tokstart[1] == '$')
  1017.     {
  1018.       negate = 1;
  1019.       c = 2;
  1020.     }
  1021.       if (c == namelen)
  1022.     {
  1023.       /* Just dollars (one or two) */
  1024.       yylval.lval = - negate;
  1025.       return LAST;
  1026.     }
  1027.       /* Is the rest of the token digits?  */
  1028.       for (; c < namelen; c++)
  1029.     if (!(tokstart[c] >= '0' && tokstart[c] <= '9'))
  1030.       break;
  1031.       if (c == namelen)
  1032.     {
  1033.       yylval.lval = atoi (tokstart + 1 + negate);
  1034.       if (negate)
  1035.         yylval.lval = - yylval.lval;
  1036.       return LAST;
  1037.     }
  1038.     }
  1039.  
  1040.   /* Handle tokens that refer to machine registers:
  1041.      $ followed by a register name.  */
  1042.  
  1043.   if (*tokstart == '$') {
  1044.     for (c = 0; c < NUM_REGS; c++)
  1045.       if (namelen - 1 == strlen (reg_names[c])
  1046.       && !strncmp (tokstart + 1, reg_names[c], namelen - 1))
  1047.     {
  1048.       yylval.lval = c;
  1049.       return REGNAME;
  1050.     }
  1051.     for (c = 0; c < num_std_regs; c++)
  1052.      if (namelen - 1 == strlen (std_regs[c].name)
  1053.      && !strncmp (tokstart + 1, std_regs[c].name, namelen - 1))
  1054.        {
  1055.      yylval.lval = std_regs[c].regnum;
  1056.      return REGNAME;
  1057.        }
  1058.   }
  1059.  
  1060.  
  1061.   /*  Lookup special keywords */
  1062.   for(i = 0 ; i < sizeof(keytab) / sizeof(keytab[0]) ; i++)
  1063.      if(namelen == strlen(keytab[i].keyw) && !strncmp(tokstart,keytab[i].keyw,namelen))
  1064.        return keytab[i].token;
  1065.  
  1066.   yylval.sval.ptr = tokstart;
  1067.   yylval.sval.length = namelen;
  1068.  
  1069.   /* Any other names starting in $ are debugger internal variables.  */
  1070.  
  1071.   if (*tokstart == '$')
  1072.     {
  1073.       yylval.ivar = (struct internalvar *) lookup_internalvar (copy_name (yylval.sval) + 1);
  1074.       return INTERNAL_VAR;
  1075.     }
  1076.  
  1077.  
  1078.   /* Use token-type BLOCKNAME for symbols that happen to be defined as
  1079.      functions.  If this is not so, then ...
  1080.      Use token-type TYPENAME for symbols that happen to be defined
  1081.      currently as names of types; NAME for other symbols.
  1082.      The caller is not constrained to care about the distinction.  */
  1083.  {
  1084.  
  1085.  
  1086.     char *tmp = copy_name (yylval.sval);
  1087.     struct symbol *sym;
  1088.  
  1089.     if (lookup_partial_symtab (tmp))
  1090.       return BLOCKNAME;
  1091.     sym = lookup_symbol (tmp, expression_context_block,
  1092.              VAR_NAMESPACE, 0, NULL);
  1093.     if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
  1094.       return BLOCKNAME;
  1095.     if (lookup_typename (copy_name (yylval.sval), expression_context_block, 1))
  1096.       return TYPENAME;
  1097.  
  1098.     if(sym)
  1099.     {
  1100.        switch(sym->class)
  1101.        {
  1102.        case LOC_STATIC:
  1103.        case LOC_REGISTER:
  1104.        case LOC_ARG:
  1105.        case LOC_REF_ARG:
  1106.        case LOC_REGPARM:
  1107.        case LOC_LOCAL:
  1108.        case LOC_LOCAL_ARG:
  1109.        case LOC_CONST:
  1110.        case LOC_CONST_BYTES:
  1111.       return NAME;
  1112.  
  1113.        case LOC_TYPEDEF:
  1114.       return TYPENAME;
  1115.  
  1116.        case LOC_BLOCK:
  1117.       return BLOCKNAME;
  1118.  
  1119.        case LOC_UNDEF:
  1120.       error("internal:  Undefined class in m2lex()");
  1121.  
  1122.        case LOC_LABEL:
  1123.       error("internal:  Unforseen case in m2lex()");
  1124.        }
  1125.     }
  1126.     else
  1127.     {
  1128.        /* Built-in BOOLEAN type.  This is sort of a hack. */
  1129.        if(!strncmp(tokstart,"TRUE",4))
  1130.        {
  1131.       yylval.ulval = 1;
  1132.       return TRUE;
  1133.        }
  1134.        else if(!strncmp(tokstart,"FALSE",5))
  1135.        {
  1136.       yylval.ulval = 0;
  1137.       return FALSE;
  1138.        }
  1139.     }
  1140.  
  1141.     /* Must be another type of name... */
  1142.     return NAME;
  1143.  }
  1144. }
  1145.  
  1146. #if 0        /* Unused */
  1147. static char *
  1148. make_qualname(mod,ident)
  1149.    char *mod, *ident;
  1150. {
  1151.    char *new = xmalloc(strlen(mod)+strlen(ident)+2);
  1152.  
  1153.    strcpy(new,mod);
  1154.    strcat(new,".");
  1155.    strcat(new,ident);
  1156.    return new;
  1157. }
  1158. #endif  /* 0 */
  1159.  
  1160. static void
  1161. yyerror(msg)
  1162.      char *msg;    /* unused */
  1163. {
  1164.    printf("Parsing:  %s\n",lexptr);
  1165.    if (yychar < 256)
  1166.      error("Invalid syntax in expression near character '%c'.",yychar);
  1167.    else
  1168.      error("Invalid syntax in expression");
  1169. }
  1170.  
  1171. /* Table of operators and their precedences for printing expressions.  */
  1172.  
  1173. const static struct op_print m2_op_print_tab[] = {
  1174.     {"+",   BINOP_ADD, PREC_ADD, 0},
  1175.     {"+",   UNOP_PLUS, PREC_PREFIX, 0},
  1176.     {"-",   BINOP_SUB, PREC_ADD, 0},
  1177.     {"-",   UNOP_NEG, PREC_PREFIX, 0},
  1178.     {"*",   BINOP_MUL, PREC_MUL, 0},
  1179.     {"/",   BINOP_DIV, PREC_MUL, 0},
  1180.     {"DIV", BINOP_INTDIV, PREC_MUL, 0},
  1181.     {"MOD", BINOP_REM, PREC_MUL, 0},
  1182.     {":=",  BINOP_ASSIGN, PREC_ASSIGN, 1},
  1183.     {"OR",  BINOP_OR, PREC_OR, 0},
  1184.     {"AND", BINOP_AND, PREC_AND, 0},
  1185.     {"NOT", UNOP_ZEROP, PREC_PREFIX, 0},
  1186.     {"=",   BINOP_EQUAL, PREC_EQUAL, 0},
  1187.     {"<>",  BINOP_NOTEQUAL, PREC_EQUAL, 0},
  1188.     {"<=",  BINOP_LEQ, PREC_ORDER, 0},
  1189.     {">=",  BINOP_GEQ, PREC_ORDER, 0},
  1190.     {">",   BINOP_GTR, PREC_ORDER, 0},
  1191.     {"<",   BINOP_LESS, PREC_ORDER, 0},
  1192.     {"^",   UNOP_IND, PREC_PREFIX, 0},
  1193.     {"@",   BINOP_REPEAT, PREC_REPEAT, 0},
  1194. };
  1195.  
  1196. /* The built-in types of Modula-2.  */
  1197.  
  1198. struct type *builtin_type_m2_char;
  1199. struct type *builtin_type_m2_int;
  1200. struct type *builtin_type_m2_card;
  1201. struct type *builtin_type_m2_real;
  1202. struct type *builtin_type_m2_bool;
  1203.  
  1204. struct type ** const (m2_builtin_types[]) = 
  1205. {
  1206.   &builtin_type_m2_char,
  1207.   &builtin_type_m2_int,
  1208.   &builtin_type_m2_card,
  1209.   &builtin_type_m2_real,
  1210.   &builtin_type_m2_bool,
  1211.   0
  1212. };
  1213.  
  1214. const struct language_defn m2_language_defn = {
  1215.   "modula-2",
  1216.   language_m2,
  1217.   m2_builtin_types,
  1218.   range_check_on,
  1219.   type_check_on,
  1220.   m2_parse,            /* parser */
  1221.   m2_error,            /* parser error function */
  1222.   &builtin_type_m2_int,        /* longest signed   integral type */
  1223.   &builtin_type_m2_card,        /* longest unsigned integral type */
  1224.   &builtin_type_m2_real,        /* longest floating point type */
  1225.   "0%XH", "0%", "XH",        /* Hex   format string, prefix, suffix */
  1226.   "%oB",  "%",  "oB",        /* Octal format string, prefix, suffix */
  1227.   m2_op_print_tab,        /* expression operators for printing */
  1228.   LANG_MAGIC
  1229. };
  1230.  
  1231. /* Initialization for Modula-2 */
  1232.  
  1233. void
  1234. _initialize_m2_exp ()
  1235. {
  1236.   /* FIXME:  The code below assumes that the sizes of the basic data
  1237.      types are the same on the host and target machines!!!  */
  1238.  
  1239.   /* Modula-2 "pervasive" types.  NOTE:  these can be redefined!!! */
  1240.   builtin_type_m2_int =
  1241.     init_type (TYPE_CODE_INT, sizeof(int), 0,
  1242.            "INTEGER", (struct objfile *) NULL);
  1243.   builtin_type_m2_card =
  1244.     init_type (TYPE_CODE_INT, sizeof(int), TYPE_FLAG_UNSIGNED,
  1245.            "CARDINAL", (struct objfile *) NULL);
  1246.   builtin_type_m2_real =
  1247.     init_type (TYPE_CODE_FLT, sizeof(float), 0,
  1248.            "REAL", (struct objfile *) NULL);
  1249.   builtin_type_m2_char =
  1250.     init_type (TYPE_CODE_CHAR, sizeof(char), TYPE_FLAG_UNSIGNED,
  1251.            "CHAR", (struct objfile *) NULL);
  1252.   builtin_type_m2_bool =
  1253.     init_type (TYPE_CODE_BOOL, sizeof(int), TYPE_FLAG_UNSIGNED,
  1254.            "BOOLEAN", (struct objfile *) NULL);
  1255.  
  1256.   TYPE_NFIELDS(builtin_type_m2_bool) = 2;
  1257.   TYPE_FIELDS(builtin_type_m2_bool) = 
  1258.      (struct field *) malloc (sizeof (struct field) * 2);
  1259.   TYPE_FIELD_BITPOS(builtin_type_m2_bool,0) = 0;
  1260.   TYPE_FIELD_NAME(builtin_type_m2_bool,0) = (char *)malloc(6);
  1261.   strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,0),"FALSE");
  1262.   TYPE_FIELD_BITPOS(builtin_type_m2_bool,1) = 1;
  1263.   TYPE_FIELD_NAME(builtin_type_m2_bool,1) = (char *)malloc(5);
  1264.   strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,1),"TRUE");
  1265.  
  1266.   add_language (&m2_language_defn);
  1267. }
  1268.